home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
smaltalk
/
st80_pr4.lha
/
st80_pre4
/
Foible
/
foible
/
BinIO-TEKfix.st
next >
Wrap
Text File
|
1993-07-24
|
5KB
|
157 lines
'From Tektronix Smalltalk-80 version T2.2.0cM3, of September 21, 1987 on 28 November 1989 at 5:47:51 pm'!
!Object methodsFor: 'comparing'!
identityHash
"Answer a SmallInteger whose value is half of the receiver's object pointer
(interpreting object pointers as 16-bit signed quantities).
Can be used if the hash method is overridden. Fails if the
receiver is a SmallInteger. Essential. See documentation in Object metaclass."
<primitive: 75>
self primitiveFailed! !
!Object methodsFor: 'public binary storage'!
storeBinary
"Writes a description of the receiver into a file, in a way that allows
the object's structure to be reconstructed from the file's contents."
| fileName |
fileName _ (FileDirectory currentDirectory)
requestFileName: 'Store binary on which file name?'
default: (self class name, '.', self asOop printString, '.stbin')
version: #any
ifFail: [^nil].
BinaryOutputManager store: self on: fileName! !
!PopUpMenu class methodsFor: 'instance creation'!
labelList: labelArray
"Create a menu with labels from those grouped in labelArray."
| stream lines line i k label|
stream _ WriteStream on: (String new: 50).
lines _ OrderedCollection new: labelArray size-1.
line _ 0.
labelArray
do: [:labels |
k _ 1.
[k <= labels size] whileTrue:
[label _ labels at: k.
i _ 1.
[i <= label size] whileTrue:
[stream nextPut: (label at: i).
i _ i + 1.].
k _ k + 1.
stream cr].
line _ line + labels size.
lines add: line].
lines isEmpty ifFalse: [lines removeLast].
stream skip: -1. "remove the final cr"
^self
labels: stream contents
lines: lines! !
!FileDirectory class reorganize!
('instance creation' currentDirectory directory:directoryName: directoryFromName:setFileName: directoryNamed: fileNamed:)
!
!TextStyle class methodsFor: 'binary storage'!
addGlobalsTo: globalDictionary manager: manager
StyleManager do: [:style|
style fontArray do: [:font|
globalDictionary at: font put: self]]!
storeBinaryDefinitionOf: anObject on: stream manager: manager
| style string |
anObject class == StrikeFont ifTrue: [
StyleManager associationsDo: [:assoc|
style _ assoc value.
1 to: style fontArray size do: [:i|
(style fontAt: i) == anObject ifTrue: [
string _ '(TextStyle styleNamed: ', assoc key storeString, ') fontAt: ', i printString.
stream nextNumber: 2 put: string size.
string do: [:char| stream nextPut: char asciiValue].
^self]]]].
^super storeBinaryDefinitionOf: anObject on: stream manager: manager! !
!String methodsFor: 'converting'!
asByteArray
"Convert the receiver to a ByteArray."
^(ByteArray new: self size) replaceFrom: 1
to: self size
withString: self
startingAt: 1! !
!FileDirectory reorganize!
('accessing' completePathname contents directoryName fullName versionNumbers)
('testing' includesKey: isEmpty statusOf:)
('adding' addKey:)
('removing' removeKey:)
('enumerating' do: filesMatching: namesDo:)
('file accessing' checkName:fixErrors: directoryNamed: file: fileClass isLegalFileName: isLegalOldFileName: newDirectory: newFile: oldFile: oldWriteOnlyFile: rename:newName:)
('file copying' append:to: copy:to:)
('alto file compatability' findKey:)
('private' beginWriting directoryFromName:setFileName: initFileName:)
('utilities' requestFileName:default:version:ifFail:)
!
!FileDirectory methodsFor: 'utilities'!
requestFileName: message default: default version: versionType ifFail: failBlock
"Prompt for a file name. Insist on an existing file if versionType = #old. Evaluate failBlock if none obtained. Note: Only works on receiving directory. New pattern doesn't allow changing directory"
"(FileDirectory directoryNamed: '' ) requestFileName: 'file:' default: '*.st' version: #any ifFail: []"
| fileName list menu index err list2|
fileName _ default.
[true] whileTrue:
[fileName _ FillInTheBlank request: message initialAnswer: fileName.
fileName isEmpty
ifTrue: [^failBlock value].
((fileName includes: $*) or: [fileName includes: $#])
ifTrue:
[list _ self filesMatching: fileName.
list2 _ list collect:
[:fname |
(fname findString: self fullName startingAt: 1) = 1
ifTrue: [fname copyFrom: self fullName size + 1 to: fname size]
ifFalse: [fname]] .
menu _ PopUpMenu
labelList: (Array
with: list2
with: #('new pattern' 'abort')).
index _ menu startUp: #anyButton withHeading:
(list isEmpty
ifTrue: [' No Matches ']
ifFalse: ['Choose a file from ', self fullName, fileName]) asText.
(index == 0 or: [index = (list size + 2)])
ifTrue: [^failBlock value].
index <= list size ifTrue: [^list at: index]]
ifFalse:
[ (self includesKey: fileName) ifTrue: [^fileName].
versionType ~= #old
ifTrue: [(self isLegalFileName: fileName)
ifTrue: [^fileName]
ifFalse: [err _ ' Illegal file name: \ ']]
ifFalse: [(self isLegalOldFileName: fileName)
ifTrue: [^fileName]
ifFalse: [err _ ' File illegal or not found \ ']].
menu _ PopUpMenu labels: 'try again\abort' withCRs.
(menu
startUp: #anyButton
withHeading: err withCRs , fileName , ' ') = 2
ifTrue: [^failBlock value]]]! !